Chip 1997 October/CD CHIP.ISO/WebServ/server7/bin/Pager.dpr

Text File | 1996-07-07 | 6.6 KB | 241 lines

library Pager;

uses
  SysUtils,
  Classes,
  Httpext,
  ISAPISock,
  Parser,
  SocketComm;

const
  SMTPHost='smtp.myhost.com';                // Address of SMTP service
  SMTPPort=25;
  PAGINGACCOUNT='[e-mail]';      // Account to receive mail requesting page
  USERNAME='justme';                         // User name needed for SMTP transaction


//
// Uses SMTP to send a mail message to the paging server. The
// subject line reads SUBJECT: P:xxxx yyyy
// where xxxx is the pager number and yyyy is the number to be
// displayed.
//
function DoPage(PagerNumber, Msg: String): Boolean;
var
  socket: TBSocketComm;
begin
  // Indicate success unless we find out otherwise...
  Result:=True;
  begin
    try
      socket:=TBSocketComm.Create;
      socket.SetTimeOut(30000);
      socket.Connect(SMTPHost, SMTPPort);
      socket.SetTXTerm(#13#10);
      socket.SetRXTerm(#13#10);

      try
        // Start speaking SMTP to get the mail message out. Note
        // if any of these calls fail, we'll still free the socket.
        socket.Writeln('MAIL FROM: '+USERNAME);
        socket.Writeln('RCPT TO: '+PAGINGACCOUNT);
        socket.Writeln('DATA');
        socket.Writeln('SUBJECT: P:'+PagerNumber+' '+Msg);
        socket.Writeln('.');
        socket.Writeln('QUIT');
        socket.Close;
      finally
        socket.Free;
      end;
    except
       // Something bad happened during the mail transaction with the
       // SMTP server. We assume the message didn't get out and flag
       // the function as having failed.
       Result:=False;
    end
  end
end;

//
// Called whenever a GET is performed with a query string. This
// is most always due to someone submitting a page.
//
procedure PageSubmitted(sock: TISAPISock);
var
  ntbd: String;
  pagerNumber: String;
  query: String;
begin
  with sock do
  begin
    HHeader('PageBoy Page Status', hcLtGray, hcBlack, hcBlue);
    HPageStart;

    // Read what was submitted
    query:=GetServerVariable('QUERY_STRING');

    // Read the Number To Be Displayed as a cookie
    ntbd:=GetCookieVal('MyNumber');

    // Parse the pager number out of the query string
    PagerNumber:=GetToken( query, 2, ['(', ')']);

    // If we don't have all the info we need, we fail.
    if ntbd='' then
      HLine('Page to '+query+' Failed! The cookie was invalid.')
    else if pagerNumber='' then
      HLine('Page to '+query+' Failed! The pager was invalid.')
    else if DoPage(pagerNumber, ntbd) then
      HLine('Page to '+query+' accepted!')
    else
      HLine('Page to '+query+' Failed! The SMPT transaction failed.');

    HPageEnd;
  end;
end;

//
// Called anytime a GET is performed on this DLL
//
procedure ProcessGet(sock: TISAPISock);
var
  fin: TextFile;
  s: String;
begin
 with sock do
 begin
   // Blast out a header
   Writeln('HTTP/1.0 200 OK');
   Writeln('Content-type: text/html');
   Writeln('Expires: 0');
   Writeln('');

   // If there is any query string, then the user
   // is submitting a page.
   if GetServerVariable('QUERY_STRING')<>'' then
     PageSubmitted(sock)
   else
   begin
     // Here a raw GET with out any query string has been
     // submitted. Blast out everything we know about the database
     // and the user's cookie.
     HHeader('PageBoy: Remote Page', hcLtGray, hcBlack, hcBlue);
     HPageStart;

     HSeparator;
     HImage( 'pageboy.gif' );
     HHeading(1,'PageBoy: Remote Page');

     // If user hits submit, we'll change his cookie
     HFormStart('POST', '/bin/Pager.dll');

     // Setup an edit box with the number to be displayed. This cookie
     // can be changed if the user hits the submit button.
     HSeparator;
     HLine( HItalic( HBold('NOTE:')+ ' If your browser supports "cookies", then a cookie will be added when you press "Change Number...". A cookie is simply a piece of information the server can request the browser to maintain until the next session.'));
     HEditBox('Number to be displayed: ', 'MyNumber', GetCookieVal('MyNumber'), 15, 15);
     HFormEnd('Change Number to be Displayed','');
     HSeparator;

     HLine( HBold('Select person to page') );
     // List out all the names of people in the
     // database. If an error occurs, we'll send that
     // to the user.
     try
       AssignFile(fin, ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
       reset(fin);
     try
       while NOT Eof(fin) do
       begin
         System.Readln(fin, s);
         HLine( HRef('/bin/Pager.dll?'+EscapeEncode(s), s) );
       end;
     finally
       CloseFile(fin);
     end;
     except
       HLine('A problem occurred reading file '+ExtractFilePath(GetServerVariable('SCRIPT_NAME'))+'database.txt');
     end;
     HSeparator;
     HPageEnd;
   end;
 end;
end;

//
// Called in response to the user wishing to change
// his Number To Be Displayed. This will update the
// cookie
//
procedure ProcessPost(sock: TISAPISock);
var
  myNumber: String;
begin
  with sock do
  begin
    Writeln('HTTP/1.0 200 OK');
    Writeln('Content-type: text/html');
    Writeln('Expires: 0');

    // Read the form value
    myNumber:=GetFormVal('MyNumber');
    // Create a cookie and make it expire in a month
    ClearCookie('MyNumber');
    SetCookie('MyNumber', myNumber, 28);
    Writeln('');

    HHeader('', hcLtGray, hcBlack, hcBlue);
    HLine('Number to be displayed is now: '+myNumber);
    HLine('Your browser has been updated.');
  end;
end;

// CASE MATTERS FOR THIS FUNCTION NAME
function GetExtensionVersion(var ver: THSE_VERSION_INFO): Boolean; stdcall;
begin
  result:=True;
end;

// CASE MATTERS FOR THIS FUNCTION NAME
function HttpExtensionProc(var ecb: TEXTENSION_CONTROL_BLOCK): LongInt; stdcall;
var
  sock: TISAPISock;
  method: String;
begin
  // Create the socket helper
  sock:=TISAPISock.Create(ecb);

  method:=sock.GetServerVariable('REQUEST_METHOD');
  if method='GET' then
    ProcessGet(sock)
  else if method='POST' then
    ProcessPost(sock)
  else
  begin
    sock.Writeln('HTTP/1.0 200 OK');
    sock.Writeln('Content-type: text/html');
    sock.Writeln('');
    sock.Writeln('I didn''t understand that request');
  end;


  // Return a normal status code
  StrLCopy( ecb.lpszLogData, PChar('DLL Finished with no errors'), HSE_LOG_BUFFER_LEN-1);
  Result:=HSE_STATUS_SUCCESS;

  // Free the socket
  sock.Free;
end;

// * REQUIRED FOR DYNAMIC BINDING.
// * Index values aren't need.
// * Case doesn't matter here.
exports
  GetExtensionVersion,
  HttpExtensionProc;

begin
end.